perm filename FMS[XX,LCS] blob
sn#231808 filedate 1976-08-16 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE FILLMS
C00009 ENDMK
Cā;
TITLE FILLMS
ENTRY FILLMS
EXTERNAL DL,DST,PLTR,LL,STF,FILLER,FLM
; PUT THIS IN FILLX FLM: BLOCK =600
;****** CHANGE 3, 4 AND 5 TO JFCL IN DDT WHEN USING DISTORTION.(SEE 'LINES')
; SUBROUTINE FILLMS(L,IDAT,R2,CENTR,R6,R7)
; COMMON/DL/RSIZ,SAVER,NAME
; COMMON/DST/BB,CC/FLM/X(600)
; DIMENSION IDAT(1),NX(600)
; EQUIVALENCE (NX,X)
; COMMON/PLTR/IPLT,RHT,DIS/LL/LL/STF/RR(8),RSTJ2
; MD=DISPLAY MP=PLOTTER MX=XGP
; DATA M2/2/
FILLMS: 0
MOVE PLTR+2 ;
MOVEM DX# ; DX=DIS
MOVE PLTR+1 ; RX=RHT
MOVEM RX#
MOVE @4(16) ; D=RSTJ2*R6
FMPR STF+10
MOVEM D#
MOVE @5(16) ; R=RSTJ2*R7
FMPR STF+10
MOVEM R#
JRST FM1 ;GO TO 1
MOVE DST+1
MOVEM C# ; C=CC
MOVE DST ; B=BB
MOVEM B# ; SAVES IT. IT WILL RETURN LATER.
FDVR PLTR+2 ; BB=B/DIS
MOVEM DST
MOVE [1000.0] ; CC=1000
MOVEM DST+1
FM1: MOVNI 13,2 ;1 KK=-2
SETZ 7 ; KK IS 13, J IS 7 DO 205 J=1,L
FM205: ADDI 13,3 ; KK=KK+3
MOVE 12,@1(16) ; KX=KK+2
; SUBROUTINE UNPACK(M,N,I)
; COMMON/LL/L
;C L IS FOR VIS. OR INVIS. LINES.
MOVEI 1,2 ; L=2
MOVE 2,@2(16) ; N=I
MOVE 4,2
IDIV 2,[=100000000] ; M=N/100000000
JUMPE 2,M2 ; IF(M.EQ.0)GO TO 2
AOJ 1, ; L=3
MOVE 4,3 ; N=N-100000000*M
;M2: MOVEM 1,LL
M2: IDIVI 4,23420 ;2 M=N/10000
; 5 IS N=MOD(N,10000)
CAIG 4,1750 ; IF(M.GT.1000)M=1000-M
JRST N2
MOVNS 4
ADDI 4,1750
N2: CAIG 5,1750 ; IF(N.GT.1000)N=1000-N
JRST P2
MOVNS 5
ADDI 5,1750
;P2: MOVEM 4,@(16)
; MOVEM 5,@1(16)
; JRA 16,3(16)
;JSA 16,UNPACK CALL UNPACK(M,N,IDAT(J))
; JUMP 10 ; M IS 10
; JUMP 11 ; N IS 11
; JUMP 12 ; 12 IS IDAT ARRAY
; NX(KX)=2
;LL IS FROM UNPACK IF(LL.EQ.3)NX(KX)=3
P2: MOVEM 1,FLM+1(5) ; LL (=2 PEN DN., =3 PEN UP.)
FLTR 4 ; X(KK)=(R2+D*M)*DIS
FMPR D ;CC X(KK)=ROFF((R2+D*M)*DIS)
FADR @2(16)
FMPR PLTR+2
MOVEM FLM-1(5)
FLTR 5 ;CC X(KK+1)=ROFF((CENTR+R*N)*RHT)
FMPR R ; X(KK+1)=(CENTR+R*N)*RHT
FADR @3(16)
FMPR PLTR+1
MOVE FLM(5)
JRST FM3 ;3 GO TO 205
MOVM FLM-1(5)
FMPR DST ; X(KK+1)=X(KK+1)*(C-BB*(ABS(X(KK))))
MOVNS ;C FOR DISTORTION
FADR C
FMPRM FLM(5)
FM3: AOJ 7 ;205 CONTINUE
CAME @(16)
JRST FM205
ADDI 13,2 ; NX(3)=KX
MOVEM 13,FLM+2
MOVSI 201400
MOVEM PLTR+2 ; DIS=1.0
MOVEM PLTR+1 ; RHT=DIS
MOVEI 10,1 ; IF(IPLT)M=RSIZ+.4
MOVE [1.7] ; IF(M.LE.0)M=1
CAMLE DL ; IF(M.GT.M2)M=M2
AOJ 10 ; AC 10 HAS FILL INCREMENT
JSA 16,FILLER
JUMP FLM
JUMP 10
MOVE DX ;2 CALL FILLER(NX,M)
MOVEM PLTR+2 ; DIS=DX
MOVE RX ; RHT=RX
MOVEM PLTR+1
FM5: JRA 16,6(16) ;5 RETURN
MOVE B ;C NEXT TO RESET DISTORTION FACT.
MOVEM DST ; BB=B
MOVE C ; CC=C
MOVEM DST+1
JRA 16,6(16) ; RETURN
END